home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
v9n04.arc
/
PLAYFISH.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-01-30
|
6KB
|
184 lines
PROGRAM PlayFish;
USES Crt, Cards, ListObj, Gofish;
TYPE
FBPlayerP = ^FBrightPlayer;
FCPlayerP = ^FCheatPlayer;
FSPlayerP = ^FShadowPlayer;
FBrightPlayer = OBJECT (FPlayer)
CardToChoose : ShortInt;
CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
DESTRUCTOR done; virtual;
PROCEDURE Chooseopponent(opps : list; VAR P : FPP); virtual;
PROCEDURE ChooseCard(VAR Cval : word); virtual;
END;
FCheatPlayer = OBJECT (FBrightPlayer)
Cheat : Boolean;
CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
DESTRUCTOR done; virtual;
FUNCTION HaveAny(num : byte) : boolean; virtual;
PROCEDURE TakeTurn(opps : list; VAR same : boolean;
VAR numl : byte; dek : DeckP); virtual;
END;
FShadowPlayer = OBJECT (FBrightPlayer)
CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
DESTRUCTOR done; virtual;
PROCEDURE SetRev(cvalu : Byte; RevIt : boolean); virtual;
END;
(*-methods for FBrightPlayer-*)
CONSTRUCTOR FBrightPlayer.Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); END;
DESTRUCTOR FBrightPlayer.done; BEGIN FPlayer.done; END;
PROCEDURE FBrightPlayer.ChooseOpponent(opps : list; VAR P : FPP);
VAR B, N : byte;
hehas : revealed;
BEGIN
CardToChoose := -1;
P := FPP(opps.NextCirc(@Self));
WHILE (P <> @Self) AND (CardToChoose = -1) DO
BEGIN
P^.Tell(heHas);
FOR B := 0 to 12 DO
IF Hehas[B] AND (HaveAny(B)) THEN CardToChoose := B;
IF (CardToChoose = -1) THEN P := FPP(opps.NextCirc(P));
END;
IF CardToChoose = -1 THEN {just guess}
BEGIN
P := FPP(FirsNotSelf(opps));
FOR N := 1 to random(6) DO P := FPP(NextNotSelf(opps, P));
IF P^.OutOfCards THEN
BEGIN
P := @Self;
REPEAT P := FPP(opps.NextCirc(P))
UNTIL (NOT P^.OutOfCards) OR (P = @Self);
IF P = @Self THEN P := FPP(opps.NextCirc(P));
END;
END;
END;
PROCEDURE FBrightPlayer.ChooseCard(VAR Cval : word);
VAR B, N : byte;
C : CardP;
BEGIN
IF CardToChoose <> -1 THEN Cval := CardToChoose
ELSE {just guess}
BEGIN
C := CardP(H^.OnBot);
FOR N := 1 to random(H^.NumInPile) DO C := H^.NextCard(C);
cval := C^.GetRank;
END;
END;
(*-methods for FCheatPlayer--*)
CONSTRUCTOR FCheatPlayer.Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); Cheat := true; END;
DESTRUCTOR FCheatPlayer.done; BEGIN FPlayer.done; END;
FUNCTION FCheatPlayer.HaveAny(num : Byte) : Boolean;
VAR temp : boolean;
BEGIN
temp := FPlayer.HaveAny(num);
IF Cheat THEN
IF temp AND (random < 0.5) THEN
BEGIN temp := false; Click; Delay(500); END;
HaveAny := temp;
END;
PROCEDURE FCheatPlayer.TakeTurn(opps : list; VAR same : boolean;
VAR numl : byte; dek : DeckP);
BEGIN
Cheat := false; {don't fool YOURSELF!}
FPlayer.TakeTurn(opps, same, numl, dek);
Cheat := true;
END;
(*-methods for FShadowPlayer-*)
CONSTRUCTOR FShadowPlayer.Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); END;
DESTRUCTOR FShadowPlayer.done; BEGIN FPlayer.Done; END;
PROCEDURE FShadowPlayer.SetRev(cvalu : Byte; RevIt : boolean);
BEGIN END; {never reveal anything}
VAR
fishgame : fish;
numPlay, N, row : Byte;
CH : Char;
name : String[10];
choices : String[9];
BEGIN
WriteLn('Time to play **GO FISH**');
WriteLn;
Fishgame.Init;
ClrScr;
Write('How many players? (2-4)');
REPEAT CH := ReadKey UNTIL (CH >= '2') AND (CH <= '4');
WriteLn(CH);
numPlay := ord(CH)-ord('0');
WriteLn('H = Human -- controlled by YOU');
WriteLn('D = Dumb -- plays at random');
WriteLn('B = Bright -- remembers what others asked for');
WriteLn('C = Cheater -- lies about its hand half the time');
WriteLn('S = Shadow -- can "cloud men''s minds"');
row := 1;
Choices := 'H D B C S';
FOR N := 1 to NumPlay DO
BEGIN
Write('Player type for player #', N, ' : (', choices, ')');
REPEAT CH := UpCase(ReadKey) UNTIL odd(pos(CH, choices));
WriteLn(CH);
Write('Name for player (10 characters) : '); ReadLn(name);
CASE CH OF
'H' : BEGIN
inc(row); {human needs an extra row}
FishGame.AddPlayer(
New(FHPlayerP, Init(2, row, yes, rt, name)));
choices := 'D B C S';
END;
'D' : FishGame.AddPlayer(
New(FMPlayerP, Init(2, row, no, rt, name)));
'B' : FishGame.AddPlayer(
New(FBPlayerP, Init(2, row, no, rt, name)));
'C' : FishGame.AddPlayer(
New(FCPlayerP, Init(2, row, no, rt, name)));
'S' : FishGame.AddPlayer(
New(FSPlayerP, Init(2, row, no, rt, name)));
END;
Inc(row, 6);
END;
WriteLn;
IF choices = 'D B C S' THEN
BEGIN
WriteLn('When it is your turn : ');
WriteLn;
WriteLn('Step 1 : Highlight another player using up/down');
WriteLn(' arrows and press ENTER to choose. You');
WriteLn(' may press "?" first for a little help.');
WriteLn('Step 2 : Point to a card using right/left arrows');
WriteLn(' and press ENTER to choose.');
WriteLn;
WriteLn('Now press a key to begin the game.');
IF ReadKey = #0 THEN;
END;
IF NumPlay = 2 THEN FishGame.DealCards(7)
ELSE Fishgame.DealCards(5);
Fishgame.Display;
Fishgame.Play;
END.